home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 076-100 / 077 / language.doc / optype.ref < prev    next >
Text File  |  1995-03-13  |  9KB  |  297 lines
  1. XV. Operator Types
  2.  
  3.     The basic syntax of operator types was given previously. They will be
  4.     discussed here by means of an example, the construction of a complex
  5.     type based on integers. First, we give an include file which would be
  6.     referenced by programs wanting to use the complex number package:
  7.  
  8.     type Complex_t = ("_cmplx", struct {int c_real, c_imag},
  9.               OPADD | OPSUB | OPMUL | OPDIV | OPNEG |
  10.               OPABS | OPCPR | OPPUT | OPGET);
  11.     Complex_t I = (0, 1);
  12.  
  13.     This declares operator type 'Complex_t' which can be used with the
  14.     binary '+', '-', '*' and '/' operators, with the unary '-', and '|'
  15.     operators, which can be compared, and which can be read/written. The
  16.     type is implemented as a structure containing two integers, and the
  17.     routines the compiler will call will all start with "_cmplx". Also
  18.     declared is a complex constant, 'I', whose value is given using a
  19.     structure constant based on the base type of Complex_t. Using these
  20.     declarations, we could write the following code fragment:
  21.  
  22.     proc main()void:
  23.         Complex_t a, b, c;
  24.  
  25.         a := Complex_t(0, 0);
  26.         b := I;
  27.         write("Enter c: ");
  28.         readln(c);
  29.         if c = Complex_t(0, 0) then
  30.         c := a * I;
  31.         b := b - (a / b);
  32.         elif c < Complex_t(0, 0) then
  33.         c := -c;
  34.         fi;
  35.         writeln("New a, b, c are: ", a, b, c);
  36.     corp;
  37.  
  38.     The various 'OPxxx' names used in the above include file are bitwise
  39.     'or'ed together to produce a 16 bit value giving the operations allowed.
  40.     Definitions of these bits can be found in file "opdef.g", as follows:
  41.  
  42.     OPADD - the binary '+' operator
  43.     OPSUB - the binary '-' operator
  44.     OPMUL - the binary '*' operator
  45.     OPDIV - the binary '/' operator
  46.     OPMOD - the binary '%' operator
  47.     OPNEG - the unary '-' operator
  48.     OPABS - the unary '|' operator
  49.     OPIOR - the binary '|' operator
  50.     OPAND - the binary '&' operator
  51.     OPXOR - the binary '><' operator
  52.     OPSHL - the binary '<<' operator
  53.     OPSHR - the binary '>>' operator
  54.     OPNOT - the unary '~' operator
  55.     OPCPR - the binary comparison operators
  56.     OPPUT - text output using 'write' and 'writeln'
  57.     OPGET - text input using 'read' and 'readln'
  58.  
  59.     The operators all have their normal precedence. The various operators
  60.     take arguments of the operator type and return a result of that type.
  61.     Exceptions to this are the shift operators, whose right operand must
  62.     be a numeric value, and the comparison operator, which yields a boolean
  63.     result. It is suggested that any uses of operator types maintain some
  64.     semblance of relation to the operators' normal meanings.
  65.  
  66.     Only a skeleton of the definition file for the above complex type will
  67.     be shown. The important things are the calling sequences used.
  68.  
  69.     #util.g
  70.  
  71.     type Complex_t = struct {int c_real, c_imag};
  72.     uint STACK_SIZE = 10;
  73.     [10] Complex_t Stack;
  74.     uint StackPointer;
  75.  
  76.     /* the psh and pop routines must be provided with ALL operator type
  77.        implementations, regardless of what else is provided */
  78.  
  79.     /* _cmplxpsh - called to push a value onto our stack */
  80.  
  81.     proc _cmplxpsh(*Complex_t x)void:
  82.  
  83.         if StackPointer = STACK_SIZE then
  84.         writeln();
  85.         writeln("*** Complex_t stack overflow - aborting. ***");
  86.         exit(1);
  87.         fi;
  88.         Stack[StackPointer] := x*;
  89.         StackPointer := StackPointer + 1;
  90.     corp;
  91.  
  92.     /* _cmplxpop - pop a value from our stack. */
  93.  
  94.     proc _cmplxpop(*Complex_t x)void:
  95.  
  96.         StackPointer := StackPointer - 1;
  97.         x* := Stack[StackPointer];
  98.     corp;
  99.  
  100.     /* _cmplxadd - add the two values on top of the stack. */
  101.  
  102.     proc _cmplxadd()void:
  103.  
  104.         StackPointer := StackPointer - 1;
  105.         Stack[StackPointer - 1].c_real :=
  106.         Stack[StackPointer - 1].c_real + Stack[StackPointer].c_real;
  107.         Stack[StackPointer - 1].c_imag :=
  108.         Stack[StackPointer - 1].c_imag + Stack[StackPointer].c_imag;
  109.     corp;
  110.  
  111.     /* similar for _cmplxsub, _cmplxmul, _cmplxdiv */
  112.  
  113.     /* _cmplxneg - negate the top of stack value */
  114.  
  115.     proc _cmplxneg()void:
  116.  
  117.         Stack[StackPointer - 1].c_real :=
  118.         - Stack[StackPointer - 1].c_real;
  119.         Stack[StackPointer - 1].c_imag :=
  120.         - Stack[StackPointer - 1].c_imag;
  121.     corp;
  122.  
  123.     /* similar for _cmplxabs (if you want to define an absolute value
  124.        operator that returns a complex result - if you want a routine
  125.        that returns the integral norm, then you must pick a name for
  126.        it, implement it here, and include a declaration for it in the
  127.        include file) */
  128.  
  129.     /* _cmplxcpr - the comparison routine - return -1, +1 or 0 */
  130.  
  131.     proc _cmplxcpr()short:
  132.         int leftSquared, rightSquared;
  133.  
  134.         StackPointer := StackPointer - 1;
  135.         rightSquared := Stack[StackPointer].c_real *
  136.                 Stack[StackPointer].c_real +
  137.                 Stack[StackPointer].c_imag *
  138.                 Stack[StackPointer].c_imag;
  139.         StackPointer := StackPointer - 1;
  140.         leftSquared := Stack[StackPointer].c_real *
  141.                 Stack[StackPointer].c_real +
  142.                 Stack[StackPointer].c_imag *
  143.                 Stack[StackPointer].c_imag;
  144.         if leftSquared < rightSquared then
  145.         make(-1, short)     /* force the result type of the if */
  146.         elif leftSquared > rightSquared then
  147.         +1
  148.         else
  149.         0
  150.         fi
  151.     corp;
  152.  
  153.     /* doing read/write on operator types requires careful interaction
  154.        with the innards of Draco's run-time system. The special channel
  155.        expression '*' means "this is a call to read/write from within
  156.        a call to read/write - use the channel that is already set up".
  157.        In this situation, the read/write constructs DO NOT return a
  158.        boolean success/fail value, and an internal routine must be
  159.        called to make the check. The special routines that can be called
  160.        are as follows:
  161.  
  162.         _channelPutChar(char ch)void -
  163.         write the character on the current output text channel
  164.         _channelGetChar()char -
  165.         get the next character from the current input text channel
  166.         _channelUnGetChar(char ch) -
  167.         stuff the character back into the current input text channel.
  168.         Only ONE character may be put back this way.
  169.         _channelError(ushort errorCode)void -
  170.         assert an error with the given code (from util.g) on the
  171.         current input text channel.
  172.         _channelHadError()bool -
  173.         return 'true' if the current input text channel has had an
  174.         error during the current top-level read/readln operation.
  175.         _channelSkip()void -
  176.         skip past whitespace (blanks and tabs) in the current input
  177.         text channel.
  178.         _readln()void -
  179.         swallow the remainder of the current input line and move on
  180.         to the next input line.
  181.         _writeln()void -
  182.         terminate the current output line and move on to the next
  183.  
  184.     */
  185.  
  186.     /* _cmplxput - write a complex number out on the current channel */
  187.  
  188.     proc _cmplxput()void:
  189.  
  190.         StackPointer := StackPointer - 1;
  191.         write(*; '(', Stack[StackPointer].c_real, ", ",
  192.             Stack[StackPointer].c_imag, ')');
  193.         /* we could have also used _channelPutChar to output the single
  194.            characters - this would have been more efficient */
  195.     corp;
  196.  
  197.     /* _cmplxget - read a complex number in from the current channel */
  198.  
  199.     proc _cmplxget(*Complex_t x)void:
  200.         extern
  201.         _channelSkip()void,
  202.         _channelGetChar()char,
  203.         _channelHadError()bool,
  204.         _channelUnGetChar(char ch)void,
  205.         _channelError(ushort errorCode)void;
  206.         char ch;
  207.  
  208.         _channelSkip();
  209.         ch := _channelGetChar();
  210.         if ch = '(' then
  211.         read(*; x*.c_real);
  212.         if not _channelHadError() then
  213.             _channelSkip();
  214.             ch := _channelGetChar();
  215.             if ch = ',' then
  216.             read(*; x*.c_imag);
  217.             if not _channelHadError() then
  218.                 _channelSkip();
  219.                 ch := _channelGetChar();
  220.                 if ch ~= ')' then
  221.                 _channelUnGetChar(ch);
  222.                 _channelError(CH_BADCHAR);
  223.                 fi;
  224.             fi;
  225.             else
  226.             _channelUnGetChar(ch);
  227.             _channelError(CH_BADCHAR);
  228.             fi;
  229.         fi;
  230.         else
  231.         _channelUnGetChar(ch);
  232.         _channelError(CH_BADCHAR);
  233.         fi;
  234.     corp;
  235.  
  236.     To solidify all of this somewhat, if we have the following fragment:
  237.  
  238. *********
  239. Operator types being untested on the Amiga version of the compiler, I'll
  240. leave this an 8080 example for now.
  241. *********
  242.  
  243.     proc nonrec test()void:
  244.         Complex_t c1, c2;
  245.  
  246.         if read(c1) then
  247.         if c1 < c2 then
  248.             writeln(c1 + c2);
  249.         fi;
  250.         else
  251.         c1 := - c2;
  252.         fi;
  253.     corp;
  254.  
  255.     It would turn into something like the following (8080 version):
  256.  
  257.     test    proc
  258.     ; a bunch of extern's that I'll omit
  259.     c1    ds    4
  260.     c2    ds    4
  261.         code
  262.         lxi    h,c1
  263.         push    h
  264.         call    _setstdin
  265.         call    _cmplxget
  266.         call    _unchannel
  267.         ana    a
  268.         jnz    L2
  269.         lxi    h,c1
  270.         call    _cmplxpsh
  271.         lxi    h,c2
  272.         call    _cmplxpsh
  273.         call    _cmplxcpr
  274.         ana    a
  275.         jp    L1
  276.         lxi    h,c1
  277.         push    h
  278.         call    _cmplxpsh
  279.         lxi    h,c2
  280.         push    h
  281.         call    _cmplxpsh
  282.         call    _cmplxadd
  283.         call    _setstdout
  284.         call    _cmplxput
  285.         call    _writeln
  286.         call    _unchannel
  287.     L1    jmp    L3
  288.     L2    lxi    h,c1
  289.         push    h
  290.         lxi    h,c2
  291.         push    h
  292.         call    _cmplxpsh
  293.         call    _cmplxneg
  294.         call    _cmplxpop
  295.     L3    ret
  296.         corp
  297.